home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / LgcyPlus / disk2 / MENUSYST._ / MENUSYST.
Encoding:
Text File  |  2001-03-02  |  8.8 KB  |  272 lines

  1. 10    ! *******************************************************************
  2. 20    ! Example: Menu System
  3. 30    !
  4. 40    ! This program demonstrates how to build a pulldown menu system.
  5. 50    ! It builds a panel with a menu and a printer widget to tell you
  6. 60    ! the menu entry you clicked.
  7. 70    !
  8. 80    ! ********************************************************************
  9. 90    !
  10. 100   INTEGER Black,White,Red,Yellow,Green,Blue,Cyan,Magenta
  11. 110   DATA 0,1,2,3,4,5,6,7
  12. 120   READ Black,White,Red,Yellow,Green,Blue,Cyan,Magenta
  13. 130   !
  14. 140   ! Define some variables:
  15. 150   !
  16. 160   !    S$:          General-purpose string variable
  17. 170   !    M$(*):       System menu elements
  18. 180   !    State:       Gets state of MENU TOGGLE widgets
  19. 190   !    N:           General-purpose INTEGER variable
  20. 200   !    D(*):        Array to get hard-clip values
  21. 210   !    Dw,Dh:       Display dimensions
  22. 220   !    X,Y:         Location of main PANEL
  23. 230   !    Panelwidth, Panelheight:  Dimensions for main PANEL
  24. 240   !    Prx,Pry,Prwidth,Prheight: Location & dimensions of main PANEL
  25. 250   !    Ih,Iw:       Interior dimensions of PANEL
  26. 260   !
  27. 270   ! The main panel is set up so it automatically scales to the
  28. 280   ! entire display, except for the DISP, INPUT, and softkeys lines.
  29. 290   !
  30. 300   DIM S$[80],M$(0:2)[80]
  31. 310   INTEGER State,N,D(1:4)
  32. 320   INTEGER Dw,Dh,X,Y
  33. 330   INTEGER Panelwidth,Panelheight,Prx,Pry,Prwidth,Prheight,Iw,Ih
  34. 340   !
  35. 350   GESCAPE CRT,3;D(*)
  36. 360   Dw=D(3)-D(1)+1
  37. 370   Dh=D(4)-D(2)+1
  38. 380   Panelwidth=Dw*.75
  39. 390   Panelheight=Dh*.75
  40. 400   X=(Dw-Panelwidth)/2
  41. 410   Y=(Dh-Panelheight)/2
  42. 420   !
  43. 430   ! Create the PANEL widget
  44. 440   !
  45. 450   CLEAR SCREEN
  46. 460   ASSIGN @P TO WIDGET "PANEL";SET ("VISIBLE":0)
  47. 470   CONTROL @P;SET ("RESIZABLE":1)
  48. 480   CONTROL @P;SET ("X":X,"Y":Y,"WIDTH":Panelwidth,"HEIGHT":Panelheight)
  49. 490   CONTROL @P;SET ("TITLE":" Example: Menu System")
  50. 500   CONTROL @P;SET ("MAXIMIZABLE":0,"RESIZABLE":0)
  51. 510   !
  52. 520   ! Create the PULLDOWN MENU widgets, using the PANEL widget as parent
  53. 530   !
  54. 540   S$="PullDown_1"
  55. 550   ASSIGN @Pd1 TO WIDGET "PULLDOWN MENU";PARENT @P,SET ("LABEL":S$)
  56. 560   !
  57. 570   S$="PullDown_2"
  58. 580   ASSIGN @Pd2 TO WIDGET "PULLDOWN MENU";PARENT @P,SET ("LABEL":S$)
  59. 590   !
  60. 600   S$="PullDown_3"
  61. 610   ASSIGN @Pd3 TO WIDGET "PULLDOWN MENU";PARENT @P,SET ("LABEL":S$)
  62. 620   !
  63. 630   ! Now that the PULLDOWN MENU has been set up, get interior dimensions
  64. 640   ! of PANEL and set up PRINTER widget accordingly.
  65. 650   !
  66. 660   STATUS @P;RETURN ("INSIDE WIDTH":Iw,"INSIDE HEIGHT":Ih)
  67. 670   Prx=Iw*.02
  68. 680   Pry=Ih*.02
  69. 690   Prwidth=Iw*.96
  70. 700   Prheight=Ih*.96
  71. 710   ASSIGN @Prn TO WIDGET "PRINTER";PARENT @P
  72. 720   CONTROL @Prn;SET ("X":Prx,"Y":Pry,"WIDTH":Prwidth,"HEIGHT":Prheight)
  73. 730   !
  74. 740   ! Create menu for "PullDown_2" (using @Pd2 as PARENT)
  75. 750   !
  76. 760   S$="Button_1"
  77. 770   ASSIGN @B21 TO WIDGET "MENU BUTTON";PARENT @Pd2,SET ("LABEL":S$)
  78. 780   !
  79. 790   S$="Button_2"
  80. 800   ASSIGN @B22 TO WIDGET "MENU BUTTON";PARENT @Pd2,SET ("LABEL":S$)
  81. 810   !
  82. 820   ! Create menu for "PullDown_3" (using @Pd3 as PARENT)
  83. 830   !
  84. 840   S$="Button_1"
  85. 850   ASSIGN @B31 TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
  86. 860   !
  87. 870   S$="Button_2"
  88. 880   ASSIGN @B32 TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
  89. 890   !
  90. 900   S$="Button_3"
  91. 910   ASSIGN @B33 TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
  92. 920   !
  93. 930   ASSIGN @S34 TO WIDGET "MENU SEPARATOR";PARENT @Pd3
  94. 940   !
  95. 950   S$="Quit"
  96. 960   ASSIGN @Quit TO WIDGET "MENU BUTTON";PARENT @Pd3,SET ("LABEL":S$)
  97. 970   !
  98. 980   ! Create menu for "PullDown_1" (using @Pd1 as PARENT)
  99. 990   !
  100. 1000  S$="Button_1"
  101. 1010  ASSIGN @B11 TO WIDGET "MENU BUTTON";PARENT @Pd1,SET ("LABEL":S$)
  102. 1020  !
  103. 1030  ! Add menu separator
  104. 1040  !
  105. 1050  ASSIGN @S12 TO WIDGET "MENU SEPARATOR";PARENT @Pd1
  106. 1060  !
  107. 1070  ! Add CASCADE MENU widgets to "PullDown_1" (using @Pd1 as PARENT)
  108. 1080  !
  109. 1090  S$="Cascade_1"
  110. 1100  ASSIGN @C13 TO WIDGET "CASCADE MENU";PARENT @Pd1,SET ("LABEL":S$)
  111. 1110  !
  112. 1120  S$="Cascade_2"
  113. 1130  ASSIGN @C14 TO WIDGET "CASCADE MENU";PARENT @Pd1,SET ("LABEL":S$)
  114. 1140  !
  115. 1150  ! Create menu for "Cascade_1" (using @C1 as PARENT)
  116. 1160  !
  117. 1170  S$="Item_1"
  118. 1180  ASSIGN @B131 TO WIDGET "MENU BUTTON";PARENT @C13,SET ("LABEL":S$)
  119. 1190  !
  120. 1200  S$="Item_2"
  121. 1210  ASSIGN @B132 TO WIDGET "MENU BUTTON";PARENT @C13,SET ("LABEL":S$)
  122. 1220  !
  123. 1230  S$="Item_3"
  124. 1240  ASSIGN @B133 TO WIDGET "MENU BUTTON";PARENT @C13,SET ("LABEL":S$)
  125. 1250  !
  126. 1260  ! Create menu for "Cascade_2" (using @C14 as PARENT)
  127. 1270  !
  128. 1280  S$="Toggle_1"
  129. 1290  ASSIGN @T141 TO WIDGET "MENU TOGGLE";PARENT @C14,SET ("LABEL":S$)
  130. 1300  !
  131. 1310  S$="Toggle_2"
  132. 1320  ASSIGN @T142 TO WIDGET "MENU TOGGLE";PARENT @C14,SET ("LABEL":S$)
  133. 1330  !
  134. 1340  S$="Toggle_3"
  135. 1350  ASSIGN @T143 TO WIDGET "MENU TOGGLE";PARENT @C14,SET ("LABEL":S$)
  136. 1360  !
  137. 1370  ! Add "Cascade_3" as entry in "Cascade_2"
  138. 1380  !
  139. 1390  S$="Cascade_3"
  140. 1400  ASSIGN @C144 TO WIDGET "CASCADE MENU";PARENT @C14,SET ("LABEL":S$)
  141. 1410  !
  142. 1420  ! Populate menu for "Cascade_3"
  143. 1430  !
  144. 1440  S$="Toggle_1"
  145. 1450  ASSIGN @T1441 TO WIDGET "MENU TOGGLE";PARENT @C144,SET ("LABEL":S$)
  146. 1460  !
  147. 1470  S$="Button_1"
  148. 1480  ASSIGN @B1442 TO WIDGET "MENU BUTTON";PARENT @C144,SET ("LABEL":S$)
  149. 1490  !
  150. 1500  ! Create SYSTEM MENU
  151. 1510  !
  152. 1520  M$(0)="SysMenu1"
  153. 1530  M$(1)="SysMenu2"
  154. 1540  M$(2)="SysMenu3"
  155. 1550  CONTROL @P;SET ("SYSTEM MENU":M$(*))
  156. 1560  !
  157. 1570  CONTROL @P;SET ("VISIBLE":1)
  158. 1580  !
  159. 1590  ! Set up menu events
  160. 1600  !
  161. 1610  ON EVENT @B11,"ACTIVATED" GOSUB Button11
  162. 1620  ON EVENT @B21,"ACTIVATED" GOSUB Button21
  163. 1630  ON EVENT @B22,"ACTIVATED" GOSUB Button22
  164. 1640  ON EVENT @B31,"ACTIVATED" GOSUB Button31
  165. 1650  ON EVENT @B32,"ACTIVATED" GOSUB Button32
  166. 1660  ON EVENT @B33,"ACTIVATED" GOSUB Button33
  167. 1670  ON EVENT @B131,"ACTIVATED" GOSUB Button131
  168. 1680  ON EVENT @B132,"ACTIVATED" GOSUB Button132
  169. 1690  ON EVENT @B133,"ACTIVATED" GOSUB Button133
  170. 1700  ON EVENT @T141,"CHANGED" GOSUB Toggle141
  171. 1710  ON EVENT @T142,"CHANGED" GOSUB Toggle142
  172. 1720  ON EVENT @T143,"CHANGED" GOSUB Toggle143
  173. 1730  ON EVENT @T1441,"CHANGED" GOSUB Toggle1441
  174. 1740  ON EVENT @B1442,"ACTIVATED" GOSUB Button1442
  175. 1750  !
  176. 1760  ON EVENT @P,"SYSTEM MENU" GOSUB Sysmenu
  177. 1770  ON EVENT @Quit,"ACTIVATED" GOTO Finis
  178. 1780  !
  179. 1790  LOOP
  180. 1800    WAIT FOR EVENT
  181. 1810  END LOOP
  182. 1820  STOP
  183. 1830  !
  184. 1840  ! *************** End of Main Program **************************
  185. 1850  !
  186. 1860  ! The following routines are handlers for the various menu buttons.
  187. 1870  ! They print the menu item description to the PRINTER widget.
  188. 1880  !
  189. 1890 Button11: !
  190. 1900  S$="PullDown_1 / Button_1"
  191. 1910  CONTROL @Prn;SET ("APPEND TEXT":S$)
  192. 1920  RETURN
  193. 1930  !
  194. 1940 Button21: !
  195. 1950  S$="PullDown_2 / Button_1"
  196. 1960  CONTROL @Prn;SET ("APPEND TEXT":S$)
  197. 1970  RETURN
  198. 1980  !
  199. 1990 Button22: !
  200. 2000  S$="PullDown_2 / Button_2"
  201. 2010  CONTROL @Prn;SET ("APPEND TEXT":S$)
  202. 2020  RETURN
  203. 2030  !
  204. 2040 Button31: !
  205. 2050  S$="PullDown_3 / Button_1"
  206. 2060  CONTROL @Prn;SET ("APPEND TEXT":S$)
  207. 2070  RETURN
  208. 2080  !
  209. 2090 Button32: !
  210. 2100  S$="PullDown_3 / Button_2"
  211. 2110  CONTROL @Prn;SET ("APPEND TEXT":S$)
  212. 2120  RETURN
  213. 2130  !
  214. 2140 Button33: !
  215. 2150  S$="PullDown_3 / Button_3"
  216. 2160  CONTROL @Prn;SET ("APPEND TEXT":S$)
  217. 2170  RETURN
  218. 2180  !
  219. 2190 Button131: !
  220. 2200  S$="PullDown_1 / Cascade_1 / Item_1"
  221. 2210  CONTROL @Prn;SET ("APPEND TEXT":S$)
  222. 2220  RETURN
  223. 2230  !
  224. 2240 Button132: !
  225. 2250  S$="PullDown_1 / Cascade_1 / Item_2"
  226. 2260  CONTROL @Prn;SET ("APPEND TEXT":S$)
  227. 2270  RETURN
  228. 2280  !
  229. 2290 Button133: !
  230. 2300  S$="PullDown_1 / Cascade_1 / Item_3"
  231. 2310  CONTROL @Prn;SET ("APPEND TEXT":S$)
  232. 2320  RETURN
  233. 2330  !
  234. 2340 Toggle141: !
  235. 2350  S$="PullDown_1 / Cascade_2 / Toggle_1: "
  236. 2360  STATUS @T141;RETURN ("VALUE":State)
  237. 2370  CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
  238. 2380  RETURN
  239. 2390  !
  240. 2400 Toggle142: !
  241. 2410  S$="PullDown_1 / Cascade_2 / Toggle_2: "
  242. 2420  STATUS @T142;RETURN ("VALUE":State)
  243. 2430  CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
  244. 2440  RETURN
  245. 2450  !
  246. 2460 Toggle143: !
  247. 2470  S$="PullDown_1 / Cascade_2 / Toggle_3: "
  248. 2480  STATUS @T143;RETURN ("VALUE":State)
  249. 2490  CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
  250. 2500  RETURN
  251. 2510  !
  252. 2520 Toggle1441: !
  253. 2530  S$="PullDown_1 / Cascade_2 / Cascade_3 / Toggle_1: "
  254. 2540  STATUS @T1441;RETURN ("VALUE":State)
  255. 2550  CONTROL @Prn;SET ("APPEND TEXT":S$&VAL$(State))
  256. 2560  RETURN
  257. 2570  !
  258. 2580 Button1442: !
  259. 2590  S$="PullDown_1 / Cascade_2 / Cascade_3 / Button_1"
  260. 2600  CONTROL @Prn;SET ("APPEND TEXT":S$)
  261. 2610  RETURN
  262. 2620  !
  263. 2630 Sysmenu: !
  264. 2640  STATUS @P;RETURN ("SYSTEM MENU EVENT":N)
  265. 2650  S$="SYSTEM MENU / SysMenu"&VAL$(N+1)
  266. 2660  CONTROL @Prn;SET ("APPEND TEXT":S$)
  267. 2670  RETURN
  268. 2680  !
  269. 2690 Finis: !
  270. 2700  ASSIGN @P TO *    ! Delete PANEL widget
  271. 2710  END
  272.